8bitfiles.net/archives/archives.tar/archives/compuserve-file-archive/22 Graphics & Utilities/PSDUMP.SRC

Text File | 2019-04-13 | 17.4 KB | 1,093 lines

.opt nosym
 chkin=$ffc6 ;kernal routines
 chkout=$ffc9
 chrout=$ffd2
 clall=$ffe7
 close=$ffc3
 clrchn=$ffcc
 getin=$ffe4
 ioinit=$ff84
 open=$ffc0
 plot=$fff0
 readst=$ffb7
 restor=$ff8a
 setlfs=$ffba
 setnam=$ffbd
 stop=$ffe1
;
 rcount=168 ;# of rows printed
 ccount=169 ;# of columns
 strlo=170 ;used by print-string routine
 strhi=171
 bitts=180 ;misc. variable
 flsh=181 ;used by cursor flash
 disk=820 ;store filename before translation
 derr=840 ;disk error message
 dsknam=49152
;
;use the monitor to:
;.l "0:psg screen",08
;.t c000 c7cf 086f
;
;files:                   device #:
;2  disk data channel     8
;4  printer               4
;15 disk command channel  8
;
 *=2049 ;build basic statement 'sys2131'
 .word 2100
 .word $0001
 .byte 158,'2131:',143,20,20,20,20,20,20,20,20,'64738:'
 .byte 143,' for gemini 10-x printer',0
 .word 2129
 .word $0002
 .byte 143,' type ',34,'run',34,' to begin...',0
 .word 0
 jmp top
datop .byte 'i0',13,0
blread .byte 'u1: 2 0 tr se',13,0
nextr .byte 18
nexse .byte 0
opscr .byte 142,147,8,0
opscr1  ;screen--fill with monitor
 *=*+1000
opscr2  ;color--fill with monitor
 *=*+1000
cursor .byte 5,163,5,183,5,184
 .byte 18,162,18,185,18,175,18,164
 .byte 18,32,18,163,18,183,18,184
 .byte 5,162,5,185,5,175,5,164,5,32
msg1 .byte 147,159
 .byte 'print ',158,'shop ',30,'graphics '
 .byte 5,'dump',13,13
 .byte 'by andrew siguenza',13,13
 .byte '   apt. 6',13,'   10739 roosevelt way ne',13
 .byte '   seattle, wa  98125',13,13
 .byte 'this program prints all the ''print',13
 .byte 'shop'' graphics on a disk onto a gemini',13
 .byte '10-x printer in rows of eight.',13,0
msg2 .byte 13,13,39,'print shop'' is a trademark of',13
 .byte 'broderund software co.',13,13,153
 .byte 158,'hold down the stop key to abort',5,13
 .byte 'insert graphics disk and press a key',0
msg3 .byte 13,'?timeout',133
errmsg .byte ' error',13,'(a)bort or (r)etry? '
 .byte 0
msg4 .byte 'retry',13,0
msg5 .byte 158,'abort',5,13,0
msg6 .byte 13,18,158,'?disk error:',5,13,0
block .byte '#'
const .byte '18 00'
point .byte 'b-p: 2 255',13,0
msg7 .byte 32,13,'ok',13,0
msg8 .byte 196,'isk ',206,'ame: ',0
msg9 .byte '?printer not on',160
msg10 .byte 146,'     page '
page .byte 48,0
flag1 .byte 0 ;rotate count
flag2 .byte 0 ;# of filename
data ;storage addresses for graphic data
 .word 23296
 .word 24064
 .word 24832
 .word 25600
 .word 26368
 .word 27136
 .word 27904
 .word 28672
msg11 .byte 13,18,' all done! ',9,0
msg12 .byte 'reading ',0
msg13 .byte 13,158,'........printing........',5,13,13,0
;
top lda #11 ;dark grey border
 sta 53280
 sta 53265 ;blank screen
 lda #0
 sta 53281 ;black screen
 jsr clall
 jsr ioinit
 jsr restor
 ldx #0 ;clear screen etc.
t1 lda opscr,x
 beq t2
 jsr chrout
 inx
 bne t1
t2 lda #0 ;move data to screen mem.
 sta 251
 lda #4
 sta 252
 lda #<opscr1 ;data pointer
 sta 253
 lda #>opscr1
 sta 254
t3 ldy #0
 lda (253),y
 sta (251),y
 inc 253 ;add 1 to data pointer
 bne *+4
 inc 254
 inc 251 ;add 1 to screen pointer
 bne *+4
 inc 252
 lda 252 ;end of screen?
 cmp #7
 bne t3 ;no
 lda 251
 cmp #231
 bne t3 ;no
 lda #0 ;yes--now do color
 sta 251
 lda #216
 sta 252
 lda #<opscr2 ;table pointer
 sta 253
 lda #>opscr2
 sta 254
t4 ldy #0
 lda (253),y
 sta (251),y
 inc 253 ;add 1 to data pointer
 bne *+4
 inc 254
 inc 251 ;add 1 to screen pointer
 bne *+4
 inc 252
 lda 252 ;end of color mem.?
 cmp #219
 bne t4 ;no
 lda 251
 cmp #231
 bne t4 ;no
 lda #27 ;yes
 sta 53265 ;un-blank screen
 ldx #23 ;move cursor position to 32,23
 ldy #32
 clc
 jsr plot
 jsr flash ;wait for key
 lda #<msg1 ;credits
 ldy #>msg1
 jsr strout
 lda #<msg2
 ldy #>msg2
 jsr strout
 jsr flash ;wait for key
 cmp #3 ;stop key pressed?
 bne *+5 ;no
 jmp abort ;yes
 lda #32 ;erase cursor
 jsr chrout
 lda #13
 jsr chrout
 lda #<msg7 ;print 'ok'
 ldy #>msg7
 jsr strout
 lda #0 ;open command channel
 jsr setnam
 lda #15 ;file no.
 ldx #8 ;device
 ldy #15 ;channel 15
 jsr setlfs
 jsr open
t5 ldx #15 ;set file #15 for output
 jsr chkout
 lda #<datop ;initialize drive
 ldy #>datop
 jsr strout
 jsr readst ;check disk status
 pha
 jsr clrchn
 pla
 and #131 ;test for error
 beq t7 ;no error
 and #3 ;no device?
 beq t6 ;yes
 lda #<msg3 ;print timeout error message
 ldy #>msg3
 jsr error
 bcc t5 ;retry
 jmp abort
t6 lda 41776 ;print device not present message
 ldy 41777
 jsr error
 bcc t5 ;retry
 jmp abort
t7 jsr erchan ;read error channel
 bcc t8 ;no error
 jsr clrchn ;reset screen output
 lda #<msg6 ;print disk error message
 ldy #>msg6
 jsr strout
 lda #<derr
 ldy #>derr
 jsr error
 bcc t5
 jmp abort
t8 lda #2 ;open direct-access buffer
 ldx #8
 ldy #2
 jsr setlfs
 lda #1
 ldx #<block
 ldy #>block
 jsr setnam
 jsr open
 jsr erchan
 bcc t9
 lda #2 ;close buffer channel
 jsr close
 jsr clrchn ;reset screen output
 lda #<msg6 ;print disk error message
 ldy #>msg6
 jsr strout
 lda #<derr
 ldy #>derr
 jsr error
 bcc t8
 jmp abort
t9 ldx #4 ;read disk name:
 lda const,x ;set 18,0
 sta blread+8,x
 dex
 bpl t9+2
 ldx #15
 jsr chkout
 lda #<blread
 ldy #>blread
 jsr strout
 jsr clrchn
 jsr erchan
 bcc t10
 lda #<msg6 ;'disk error'
 ldy #>msg6
 jsr strout
 lda #<derr
 ldy #>derr
 jsr error
 bcc t9
 jmp abort
t10 lda #'1 ;buffer point to 144
 sta point+7
 lda #'4
 sta point+8
 sta point+9
 ldx #15
 jsr chkout
 lda #<point
 ldy #>point
 jsr strout
 jsr clrchn
 lda #0
 jsr dname
t11 jsr opengr ;open printer file
 jsr clrchn
 ldx #4 ;test for printer present
 jsr chkout
 lda #0
 jsr chrout
 jsr readst ;check printer status
 and #255 ;error?
 beq t12 ;no
 lda #4 ;yes--close printer file
 jsr close
 jsr clrchn
 lda #<msg9 ;'?printer not on'
 ldy #>msg8
 jsr error
 bcc t11 ;retry
 jmp abort
t12 lda #'0
 sta page ;set page number
 jsr ptop ;output to printer
 lda #0
 sta rcount
 inc blread+12 ;set up to read 18,1
 lda #0 ;first filename
 sta ccount
 lda #18
 sta nextr
 sta oldtr
 lda #1
 sta oldse
 sta nexse
 lda #8
 sta flag2
main jsr stop
 bne *+5
 jmp abort
 jsr clrchn
 lda flag2
 cmp #8 ;last filename in block?
 bne ma0 ;no
 lda nextr ;yes
 cmp #0 ;last directory block?
 bne *+5 ;no
 jmp print ;yes-we're done, print last row
 jsr readtr
 lda #0
 sta flag2
ma0 asl a ;get ascii characters from table
 clc ;  to set buffer pointer to read
 adc flag2 ;  next file name
 tax
 inc flag2
 lda numbr2,x
 sta point+7
 lda numbr2+1,x
 sta point+8
 lda numbr2+2,x
 sta point+9
 ldx #15
 jsr chkout
 lda #<point
 ldy #>point
 jsr strout
 jsr clrchn
 ldx #2
 jsr chkin
 jsr getin ;check file type
 and #131
 cmp #130 ;program?
 bne main ;no
 jsr getin ;skip 2-byte block link
 jsr getin
 ldx ccount
 inx
 txa
 jsr dname
 ldx #2
 jsr chkin
 ldx #8 ;skip over 9 bytes
 stx bitts
ma1 jsr getin
 dec bitts
 bpl ma1
 jsr getin ;get no. blocks in file
 sta 251
 jsr getin
 sta 252
 lda #3 ;test for 3-block length
 cmp 251
 bne *+8
 lda #0
 cmp 252
 beq *+5
 jmp main
 lda #2 ;close direct access, open regular
 jsr close ;  program file access
 jsr clrchn
 lda #<msg12 ;'reading' filename
 ldy #>msg12
 jsr strout
 ldx ccount ;find filename
 inx
 txa
 jsr mult48
 lda #192
 clc
 adc 254
 sta 254
 lda 253
 ldy 254
 jsr strout ;print filename
 lda #13 ;print cr
 jsr chrout
 ldx #3
ma2 lda data2,x ;append ',p,r'
 sta 836,x
 dex
 bpl ma2
 lda #20
 ldx #<disk
 ldy #>disk
 jsr setnam
 lda #2
 ldx #8
 ldy #2
 jsr setlfs
 jsr open
 jsr erchan ;error?
 bcc ma3
 lda #2
 jsr close
 jsr clrchn
 lda #<msg6 ;'disk error'
 ldy #>msg6
 jsr strout
 lda #<derr
 ldy #>derr
 jsr error
 bcc ma2+9
 jmp abort
ma3 ldx #2
 jsr chkin
 jsr getin ;skip over load address
 jsr getin
 jsr readst ;error?
 and #255
 beq *+5
 jmp main ;end of file, skip it
 lda #88
 sta 252 ;set pointer to ps graphic data
 lda #0
 sta 251
 sta 253 ;set byte counter
 sta 254
ma4 jsr getin
 ldy #0
 sta (251),y
 jsr readst ;check for end-of-file
 and #255
 bne ma5 ;end
 lda #2 ;check for 572 bytes received
 cmp 254 ;  (print shop grahpic file
 bne *+10 ;  is 572 bytes long)
 lda #60
 cmp 253
 bne *+4
 beq ma5
 inc 251 ;increment pointers
 bne *+4
 inc 252
 inc 253
 bne ma4
 inc 254
 bne ma4
ma5 inc 251 ;when routine gets to here,
 bne *+4 ;  pointers point to last
 inc 252 ;  byte loaded
 inc 253
 bne *+4
 inc 254
 lda #2
 jsr close
 ldy #0 ;fill rest of graphic area with
ma6 tya ;  zeros
 sta (251),y
 inc 251
 bne *+4
 inc 252
 inc 253
 bne *+4
 inc 254
 lda 253 ;done? (768 bytes per graphic
 cmp #0 ;  area)
 bne ma6 ;no
 lda 254
 cmp #3
 bne ma6 ;no
 lda #$58 ;rotate graphic data for printer
 sta roa+2
 lda ccount ;get high byte for destination
 asl a ;  address
 tax
 inx
 lda data,x
 sta rob+2
 clc
 adc #2 ;this number will serve as the end-
 sta flag1 ;  of-rotate flag
 lda #11
 sta roc
 lda #0
 sta roa+1
 sta rob+1
ro1 ldy #$07
ro2 ldx #$4d
 lda #$00
ro3 clc
roa lsr $5800,x ;this address gets modified
 ror a ;when the program runs
 dex
 dex
 dex
 dex
 dex
 dex
 dex
 dex
 dex
 dex
 dex
 bpl ro3
rob sta $5a00,y ;this address gets modified
 dey ;  when the program runs
 bpl ro2
 inc roa+1
 bne ro4
 inc roa+2
ro4 lda roa+1
 cmp roc
 bne ro6
 clc
 adc #$4d
 sta roa+1
 bcc ro5
 inc roa+2
 clc
ro5 adc #11 ;next row
 sta roc
 cmp #115
 beq ro7
ro6 lda #8
 clc
 adc rob+1
 sta rob+1
 bcc ro1
 inc rob+2
 jmp ro1
ro7 lda rob+2
 cmp flag1
 bne ro1
;
ma7 lda #2 ;re-open direct-access channel
 ldx #8
 ldy #2
 jsr setlfs
 lda #1
 ldx #<block
 ldy #>block
 jsr setnam
 jsr open
 jsr erchan ;disk error?
 bcc ma8 ;no
 lda #<msg6 ;yes
 ldy #>msg6
 jsr strout
 lda #<derr
 ldy #>derr
 jsr error
 bcc ma7
 jmp abort
ma8 lda oldtr ;re-read directory block
 sta nextr
 lda oldse
 sta nexse
 jsr readtr
 inc ccount ;increment column counter
 lda #8
 cmp ccount ;time to print a row?
 beq print ;yes
 jmp main ;no
print jsr clrchn
 lda #<msg13 ;'printing'
 ldy #>msg13
 jsr strout
 ldx #4
 jsr chkout
 lda #0 ;7 hi-res rows to print
 sta 251
pr0 lda ccount ;no. of graphics to print
 sta 252 ;  (normally seven except for
pr1 dec 252 ;  last row)
 bmi prnext ;this byte row is done
 ldx ccount ;pointer to entry in table
 dex ;  = (6-column number)*2
 txa
 sec
 sbc 252
 asl a
 tax
 lda data,x ;get base pointer
 sta 253
 lda data+1,x
 sta 254
 lda 251 ;add row increment
 asl a
 tax
 lda numbr3,x
 clc
 adc 253
 sta 253
 lda numbr3+1,x
 adc 254
 sta 254
 jsr opengr
 ldx #4
 jsr chkout
 ldx #0
 stx bitts
pra lda dbits,x
 jsr chrout
 ldx bitts
 inx
 stx bitts
 cpx #4
 bne pra
 ldy #0
pr3 lda (253),y
 jsr chrout
 iny
 cpy #88
 bne pr3
 lda #<space
 ldy #>space
 jsr strout
 jmp pr1 ;do next column
prnext lda #<crlf
 ldy #>crlf
 jsr strout
 jsr stop ;test stop key
 bne *+5
 jmp abort
 inc 251 ;increment byte row counter
 lda #7
 cmp 251 ;last byte row done?
 bne pr0 ;no
 lda #<crlf ;yes--print one blank line
 ldy #>crlf
 jsr strout
 lda #<comprs ;set 15 pitch
 ldy #>comprs
 jsr strout
 jsr opentx
 ldx #4
 jsr chkout
 ldx ccount ;now print graphic names
 stx bitts
pr4 dec bitts
 bmi prdone
 ldx ccount ;filename is at (6-ccount)*48 + 49200
 dex
 txa
 sec
 sbc bitts
 jsr mult48
 lda #48
 clc
 adc 253
 sta 253
 lda 254
 adc #192
 sta 254
 lda 253
 ldy 254
 jsr strout ;print name
 lda #146 ;rvs-off (printer code)
 jsr chrout
 lda #32 ;space between names
 jsr chrout
 jmp pr4
prdone jsr opengr
 ldx #4
 jsr chkout
 lda #<elite ;reset 12 pitch
 ldy #>elite
 jsr strout
 ldx #3 ;cr + 3 blank lines
 stx bitts
pr6 lda #<crlf
 ldy #>crlf
 jsr strout
 dec bitts
 bpl pr6
 inc rcount ;end of page?
 lda #7
 cmp rcount
 bne pr7 ;no
 ldx #5 ;yes--print six blank lines at
 stx bitts ;  the bottom
pr6a lda #<crlf
 ldy #>crlf
 jsr strout
 dec bitts
 bpl pr6a
 jsr ptop ;  and print the header
pr7 jsr clrchn
 lda #0
 sta ccount
 lda nextr ;was this the last row?
 cmp #0
 beq *+5
 jmp main ;no
 lda flag2
 cmp #8
 bne *-8 ;no
;
abort lda #4 ;close printer file
 jsr close
 lda #2 ;close disk data channel
 jsr close
 lda #15 ;close disk command channel
 jsr close
 jsr clall ;reset i/o
 lda #<msg11 ;print 'all done'
 ldy #>msg11
 jsr strout
 rts ;return to basic
;
;more data
prinit .byte 27,65,8,27,85,1,0
crlf .byte 13,10,0
dbits .byte 27,76,88,0
elite .byte 27,66,2,0
comprs .byte 27,66,3,0
space .byte '   ',0
number .byte '00010203040506070809101112131415'
 .byte '16171819202122232425262728293031'
numbr2 .byte '002034066098130162194226'
roc .byte 169
numbr3 .byte 0,0,88,0,176,0,8,1
 .byte 96,1,184,1,16,2
data2 .byte ',p,r'
oldtr .byte 18
oldse .byte 1
pica .byte 27,66,1,0
;
;subroutines start here
;
flash lda #0 ;flash cursor, wait for key
 sta flsh ;cursor data pointer
fl1 jsr getin ;check keyboard
 cmp #0 ;key pressed?
 beq *+3 ;no
 rts ;yes
 lda flsh ;get pointer (0-15)
 asl a ;multiply by 2
 tax
 lda cursor,x ;get cursor character
 jsr chrout ;print it
 inx
 lda cursor,x
 jsr chrout
 lda #146 ;rvs-off
 jsr chrout
 lda #157 ;cursor left
 jsr chrout
 ldx flsh ;add 1 to pointer
 inx
 txa
 and #15
 sta flsh
 ldy #35
fl2 ldx #255 ;short delay
fl3 dex
 bne fl3
 dey
 bne fl2
 beq fl1 ;delay done
;
error sta 251
 sty 252
 jsr clrchn ;reset screen/keyboard
er1 ldy #0
 lda (251),y ;read table
 pha
 and #127
 jsr chrout
 pla
 and #128 ;end of table?
 bne er2 ;yes
 inc 251 ;add 1 to pointer
 bne er1
 inc 252
 bne er1 ;always goes
er2 lda #<errmsg ;print ' error'
 ldy #>errmsg
 jsr strout
 jsr flash
 cmp #82 ;'r'?
 bne er3 ;no
 lda #<msg4 ;yes--retry
 ldy #>msg4
 jsr strout
 clc
 rts
er3 lda #<msg5 ;no--abort
 ldy #>msg5
 jsr strout
 sec
 rts
;
erchan ldx #15 ;read disk error channel
 jsr chkin
 ldy #4 ;error message has 4 cr's
 sty 251
 ldx #0
 stx 252
erc1 jsr getin
 cmp #0 ;note:  drive should not return
 beq erc2 ;  a zero byte
 cmp #13 ;cr?
 bne *+4 ;no
 lda #44 ;yes--change to ','
 ldx 252
 sta derr,x
 inc 252
 cmp #44
 bne erc1
 dec 251
 bne erc1
 ldx 252
 dex ;change last comma to shift-space
 lda #160 ; for error subroutine
 sta derr,x
 jsr clrchn
 lda #48 ;ascii zero
 cmp derr ;check for error--set carry if error
 bne erc2
 cmp derr+1
 bne erc2
 clc
 rts
erc2 sec
 rts
;
strout sta strlo ;low byte
 sty strhi ;high byte
st1 ldy #0
 lda (strlo),y
 cmp #0
 beq st2
 jsr chrout
 inc strlo
 bne st1
 inc strhi
 bne st1
st2 rts
;
dname sta 254
 ldx #0 ;get 16-character name
 stx 251
 ldx #2 ;buffer channel
 jsr chkin
dn2 jsr getin
 ldx 251
 sta disk,x
 inx
 stx 251
 cpx #16
 bne dn2
 jsr clrchn
 lda 254
 jsr mult48 ;pointer=no. x 48 + 49152
 lda #192
 clc
 adc 254
 sta 254
 ldy #0 ;translate 16-character file name
 ldx #0 ;  and store in high memory
dn3 lda disk,x ;read next byte
 cmp #27 ;translation table:
 bcs dn4 ; 0 - 26:  rvs+(@-z)
 jsr dnsub ;     27:  rvs colon
 jmp dnx ;     28:  rvs brit. pound
dn4 cmp #27 ;     29:  rvs semi-colon
 bne dn5 ;     30:  rvs up-arrow
 lda #58 ;     31:  rvs equal-sign
 jsr dnsub ;32 -127:  as is
 jmp dnx ;128-159:  rvs 96-127
dn5 cmp #28 ;    160:  32 (space)
 bne dn6 ;161-191:  as is
 lda #92 ;192-223:  same as 96-127
 jsr dnsub ;224-254:  same as 160-190
 jmp dnx ;    255:  same as 126
dn6 cmp #29
 bne dn7
 lda #59
 bne dn5+6
dn7 cmp #30
 bne dn8
 lda #94
 bne dn5+6
dn8 cmp #31
 bne dn9
 lda #61
 bne dn5+6
dn9 cmp #128
 bcs dn10
 bcc dnw
dn10 cmp #160
 bcs dn11
 sec
 sbc #32
 jsr dnsub
 jmp dnx
dn11 cmp #160
 bne dn12
 lda #32
 bne dnw
dn12 cmp #191
 bcc dnw
 cmp #224
 bcs dn13
 sec
 sbc #96
 bne dnw
dn13 cmp #255
 bcs dn14
 sec
 sbc #64
 bne dn11
dn14 lda #126
dnw sta (253),y
 iny
dnx inx
 cpx #16 ;done?
 bne dn3 ;no
 lda #0
dny cpy #48
 beq dnz
 sta (253),y
 iny
 bne dny
dnz rts
;
dnsub pha ;part of dname routine
 lda #18 ;rvs-on (printer code)
 sta (253),y
 pla ;character to be printed
 iny
 sta (253),y
 iny
 lda #146 ;rvs-off (printer code)
 sta (253),y
 iny
 rts
;
;
opentx lda #4 ;close old file
 jsr close
 lda #0
 jsr setnam
 lda #4 ;open printer file for text
 ldx #4
 ldy #8 ;no linefeed added by interface
 jsr setlfs
 jsr open
 ;jsr clrchn
 rts
;
opengr lda #4 ;close old file
 jsr close
 lda #0
 jsr setnam
 lda #4 ;open printer file for graphics
 ldx #4 ;set interface for pass-through
 ldy #5 ;and no linefeed
 jsr setlfs
 jsr open
 ;jsr clrchn
 rts
;
ptop inc page ;add 1 to page counter
 jsr opengr ;initialize printer
 ldx #4
 jsr chkout
 lda #<prinit ;set 17/144 linefeed, unidirectional print
 ldy #>prinit
 jsr strout
 ldx #5
 stx 251 ;set counter to print 5 blank
pt1 lda #<crlf ;  lines
 ldy #>crlf
 jsr strout
 dec 251
 bne pt1
 ldy #>pica ;set printer for 10 cpi
 lda #<pica
 jsr strout
 jsr opentx
 ldx #4
 jsr chkout
 lda #<msg8 ;'disk name:'
 ldy #>msg8
 jsr strout
 lda #<dsknam ;print disk name
 ldy #>dsknam
 jsr strout
 lda #<msg10 ;print page number
 ldy #>msg10
 jsr strout
 ldx #4 ;carriage return + 3 blank lines
 stx 251
pt2 lda #<crlf
 ldy #>crlf
 jsr strout
 dec 251
 bne pt2
 jsr clrchn
 lda #0 ;reset row counter
 sta rcount
 jsr opengr
 ldx #4
 jsr chkout
 lda #<elite
 ldy #>elite
 jmp strout ;jump and return
;
mult48 pha ;this routine multiplies a
 lda #0 ;  one-byte number in the
 sta 252 ;  accumulator by 48 and stores
 pla ;  it in 253,254 (low byte, high
 sta 251 ;  byte)
 ldx #4 ;double four times = 16
mu1 asl 251
 rol 252
 dex
 bne mu1
 lda 251 ;now multiply by 3 by repeated
 sta 253 ;  addition
 lda 252
 sta 254
 ldx #2
mu2 lda 253
 clc
 adc 251
 sta 253
 lda 254
 adc 252
 sta 254
 dex
 bne mu2
 rts ;result = 3x16 = 48
;
readtr lda nextr
 sta oldtr
 lda nexse
 sta oldse
 lda nextr ;read next track & sector and
 and #31 ;  next-track pointer
 asl a
 tax
 lda number,x ;convert binary to 2-digit ascii
 sta blread+8 ;  by reading look-up table
 lda number+1,x
 sta blread+9
 lda nexse
 and #31
 asl a
 tax
 lda number,x
 sta blread+11
 lda number+1,x
 sta blread+12
re1 ldx #15
 jsr chkout
 lda #<blread
 ldy #>blread
 jsr strout
 jsr clrchn
 jsr erchan
 bcc re2
 lda #<msg6 ;'disk error'
 ldy #>msg6
 jsr strout
 lda #<derr
 ldy #>derr
 jsr error
 bcc re1
 pla ;clear subroutine return address
 pla
 jmp abort
re2 ldx #2
 jsr chkin
 jsr getin ;get byte #0 (next track)
 sta nextr
 jsr getin
 sta nexse
 rts
;
 .end